home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-03
/
qbfaqr01.zip
/
DIRSUBS.BAS
< prev
next >
Wrap
BASIC Source File
|
1991-05-06
|
6KB
|
180 lines
DEFINT A-Z
'$INCLUDE: 'DIR.BI' '***DirSubs header file***
FUNCTION FreeSpace& (FCurrentDrive AS INTEGER)
'*** Return free disk space of drive as pointed to by FCurrentDrive ***
'*** Where 0 = default, 1=A, 2=B, 3=C etc. ***
Dregs.AX = &H3600
Dregs.DX = FCurrentDrive
CALL InterruptX(&H21, Dregs, Dregs) '***Get bytes free***
FreeSpace& = CLNG(Dregs.AX) * Dregs.BX * Dregs.CX
END FUNCTION
FUNCTION GetCurrentDrive%
'*** Returns default drive number ***
Dregs.AX = &H1900
CALL InterruptX(&H21, Dregs, Dregs)
GetCurrentDrive% = (Dregs.AX AND 255) + 1 '***A=1, B=2. C=3 etc.***
END FUNCTION
FUNCTION GetNumberOfDrives
'***Returns number of drives or LASTDRIVE whichever is greater***
CurrentDrive = GetCurrentDrive% '*** Save current logged drive ***
Dregs.AX = &HE00
Dregs.DX = 0 '*** Set to drive A (all pc's should have) ***
CALL InterruptX(&H21, Dregs, Dregs)
GetNumberOfDrives = (Dregs.AX AND 15)
Dregs.AX = &HE00
Dregs.DX = CurrentDrive - 1 '*** Restore drive to default ***
CALL InterruptX(&H21, Dregs, Dregs)
END FUNCTION
FUNCTION GetVolumeName$ (VDir$)
'***Returns volume name of disk referenced by VDir$)
DIM FileSpec AS STRING * 60
FileSpec = VDir$ + "*.*" + CHR$(0)
Dregs.DS = VARSEG(DInfo) '*** Set Pointers to temporary storage array ***
Dregs.DX = VARPTR(DInfo)
Dregs.AX = &H1A00 '*** Interrupt $21, Function $1A ***
CALL InterruptX(&H21, Dregs, Dregs) '*** Set disk xfer address ***
Dregs.AX = &H4E00 '*** Find First entry ***
Dregs.CX = 8 '*** Only Volume Name returned ***
VSEG% = VARSEG(FileSpec) '*** Set pointers to FileSpec ***
VPTR% = VARPTR(FileSpec)
DoneFlag = FALSE
DO
Dregs.DS = VSEG%
Dregs.DX = VPTR%
CALL InterruptX(&H21, Dregs, Dregs) '***1st time AX=$4E (find 1st entry) ***
IF (Dregs.FLAGS AND 1) = FALSE THEN '***Entry is found***
IF (ASC(DInfo.ATT) AND 8) = 8 THEN
VolumeName$ = DInfo.FName
Period = INSTR(DInfo.FName, ".")
IF Period <> 0 THEN
VolumeName$ = LEFT$(DInfo.FName, Period - 1) + MID$(DInfo.FName, Period + 1, LEN(DInfo.FName))
ELSE
VolumeName$ = DInfo.FName
END IF
GetVolumeName$ = LEFT$(VolumeName$, INSTR(VolumeName$, CHR$(0)) - 1)
DoneFlag = True '***If found then quit looking ***
END IF
Dregs.AX = &H4F00 '***Read next entry***
ELSE
DoneFlag = True '***No more entries***
END IF
LOOP UNTIL DoneFlag = True
END FUNCTION
DEFSNG A-Z
FUNCTION ReadDir& (RDIR$, RFTYPE$)
'*** READS DIRECTORY INTO TD.Info() ARRAY ***
'*** Returns the number of files found ***
'*** RDIR$=directory path..must end with \ or left blank for current***
'*** RFTYPE$=parameters such as *.* ***
DIM FileSpec AS STRING * 60
FileSpec = RDIR$ + RFTYPE$ + CHR$(0)
FI = 0
Dregs.DS = VARSEG(DInfo) '*** Set Pointers to temporary storage array ***
Dregs.DX = VARPTR(DInfo)
Dregs.AX = &H1A00 '*** Interrupt $21, Function $1A ***
CALL InterruptX(&H21, Dregs, Dregs) '***Set disk xfer address ***
Dregs.AX = &H4E00 '*** Find First entry ***
Dregs.CX = 55 '*** Set to 0 to not include directories ***
VSEG% = VARSEG(FileSpec) '*** Set pointers to FileSpec ***
VPTR% = VARPTR(FileSpec)
DoneFlag = FALSE
DO
Dregs.DS = VSEG%
Dregs.DX = VPTR%
CALL InterruptX(&H21, Dregs, Dregs) '***1st time AX=$4E (find 1st entry) ***
IF (Dregs.FLAGS AND 1) = FALSE THEN '***Entry is found***
FI = FI + 1
'***Get filename***
F$ = DInfo.FName
TDInfo(FI).FName = LEFT$(F$, INSTR(F$, CHR$(0)) - 1)
TDInfo(FI).Date = " - - "
TDInfo(FI).Time = " : : "
'***Assemble date***
MID$(TDInfo(FI).Date, 1, 2) = RIGHT$("0" + LTRIM$(STR$((DInfo.Date AND 480) \ 32)), 2)
MID$(TDInfo(FI).Date, 4, 2) = RIGHT$("0" + LTRIM$(STR$((DInfo.Date AND 31))), 2)
MID$(TDInfo(FI).Date, 7, 4) = LTRIM$(STR$((DInfo.Date AND 65024) \ 512 + 1980))
'***Assemble Time***
MID$(TDInfo(FI).Time, 1, 2) = RIGHT$("0" + LTRIM$(STR$((DInfo.Time AND 63488) \ 2048)), 2)
MID$(TDInfo(FI).Time, 4, 2) = RIGHT$("0" + LTRIM$(STR$((DInfo.Time AND 2016) \ 32)), 2)
MID$(TDInfo(FI).Time, 7, 2) = RIGHT$("0" + LTRIM$(STR$((DInfo.Time AND 31))), 2)
'***Get filesize***'
TDInfo(FI).Size = DInfo.Size
'***Set attributes***
TDInfo(FI).D = (ASC(DInfo.ATT) AND 16) = 16
TDInfo(FI).R = (ASC(DInfo.ATT) AND 1) = 1
TDInfo(FI).A = (ASC(DInfo.ATT) AND 32) = 32
TDInfo(FI).S = (ASC(DInfo.ATT) AND 4) = 4
TDInfo(FI).H = (ASC(DInfo.ATT) AND 2) = 2
IF TDInfo(FI).S = True OR TDInfo(FI).H = True THEN
'***Make System or Hidden files lower case***
TDInfo(FI).FName = LCASE$(TDInfo(FI).FName)
'FI = FI - 1 '***Remove REM to not display System/Hidden files***
END IF
Dregs.AX = &H4F00 '***Read next entry***
ELSE
DoneFlag = True '***No more entries***
END IF
LOOP UNTIL DoneFlag = True
ReadDir = FI '***Return number of entries found***
END FUNCTION
SUB SortDir (SNumberOfFiles AS INTEGER)
'***SORT DIRECTORY BY FILENAME (SHELL SORT)***
'***Sorts in ascending order***
'***Set number of passes required to sort array***
IF SNumberOfFiles = 0 THEN
TPASS = 0
ELSE
TPASS = INT(LOG(SNumberOfFiles) / LOG(2))
END IF
MidPoint = SNumberOfFiles
'***SORT DIRECTORY***
FOR L = 1 TO TPASS
MidPoint = MidPoint \ 2
FOR I = MidPoint TO SNumberOfFiles - 1
FOR J = (I - MidPoint + 1) TO 1 STEP -MidPoint
IF (UCASE$(TDInfo(J).FName) > UCASE$(TDInfo(J + MidPoint).FName)) THEN
'***Put directories at top of listing***
IF TDInfo(J).D = True AND TDInfo(J + MidPoint).D = FALSE THEN
EXIT FOR
ELSE
SWAP TDInfo(J), TDInfo(J + MidPoint)
END IF
ELSE
IF TDInfo(J).D = FALSE AND TDInfo(J + MidPoint).D = True THEN
SWAP TDInfo(J), TDInfo(J + MidPoint)
ELSE
EXIT FOR
END IF
END IF
NEXT J
NEXT I
NEXT L
'*********************
END SUB